module Main where

import Hscm.Value
import Hscm.Primitive (primitiveEnv)
import Hscm.Parse (parse)
import Hscm.Eval (eval)

import System.Environment
import System.IO
import Control.Monad
import Control.Monad.Except

main :: IO ()
main = do args <- getArgs
          case length args of
               0 -> runRepl
               1 -> runExecute $ args !! 0
               _ -> putStrLn "Program takes only 0 or 1 argument"


runExecute :: String -> IO ()
runExecute fileName = do
    envRef <- primitiveEnv
    (envRef', _) <- parseEval (envRef, "(load \"./source/prelude.scm\")")
    (envRef'', context) <- parseEval (envRef', "(load \"" ++ fileName ++ "\")")
    print context


runRepl :: IO ()
runRepl = do
    envRef <- primitiveEnv
    (envRef, _) <- parseEval (envRef, "(load \"./source/prelude.scm\")")
    until_ envRef (== "(exit)") (readPrompt "Hscm> ")


until_ :: HscmEnvRef -> (String -> Bool) -> IO String -> IO ()
until_ envRef pred prompt = do
    input <- prompt
    if pred input
        then return ()
        else do
            (envRef', context) <- parseEval (envRef, input)
            putStrLn context
            until_ envRef' pred prompt 


parseEval :: (HscmEnvRef, String) -> IO (HscmEnvRef, String)
parseEval (envRef, input) = case parse input of
    Left error  -> return (envRef, show error)
    Right value -> do
        res <- runExceptT $ eval envRef value
        case res of
            Left error   -> return (envRef, show error)
            Right (envRef', value') -> return (envRef', show value')


flushStr :: String -> IO ()
flushStr str = putStr str >> hFlush stdout


readPrompt :: String -> IO String
readPrompt prompt = flushStr prompt >> getLine

